home *** CD-ROM | disk | FTP | other *** search
Text File | 1990-10-25 | 43.0 KB | 1,735 lines | [TEXT/MPS ] |
- {$P}
- {[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
- { UMacApp.TDocument.p }
- { Copyright © 1984-1990 by Apple Computer Inc. All rights reserved. }
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAWriteFile}
-
- PROCEDURE TSaveDocCommand.DoIt;
-
- BEGIN
- fChangedDocument.Save(fCmdNumber,
- {askForFilename:} NOT fChangedDocument.fSaveExists | (fCmdNumber <> cSave),
- {makingCopy:} fCmdNumber = cSaveCopy);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MASelCommand}
-
- PROCEDURE TSaveDocCommand.ISaveDocCommand(itsCmdNumber: CmdNumber;
- itsDocument: TDocument);
-
- BEGIN
- INoChangesCommand(itsCmdNumber, itsDocument, NIL, NIL);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAFields}
-
- PROCEDURE TSaveDocCommand.Fields(PROCEDURE DoToField(fieldName: Str255;
- fieldAddr: Ptr;
- fieldType: INTEGER)); OVERRIDE;
-
- BEGIN
- DoToField('TSaveDocCommand', NIL, bClass);
- INHERITED Fields(DoToField);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAReadFile}
-
- PROCEDURE TRevertDocCommand.DoIt;
-
- VAR
- name: Str255;
- fi: FailInfo;
-
- PROCEDURE HdlRevertCmd(error: OSErr;
- message: LONGINT);
-
- BEGIN
- fChangedDocument.ShowReverted; { make sure screen is updated }
- END;
-
- BEGIN
- name := fChangedDocument.fTitle^^;
- ParamText(name, '', '', '');
- IF MacAppAlert(phRevert, NIL) = kYesButton THEN {!!! This should be programatically
- defeatable }
- BEGIN
- CatchFailures(fi, HdlRevertCmd);
- fChangedDocument.Revert;
- Success(fi);
- fChangedDocument.ShowReverted;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MASelCommand}
-
- PROCEDURE TRevertDocCommand.IRevertDocCommand(itsCmdNumber: CmdNumber;
- itsDocument: TDocument);
-
- BEGIN
- INoChangesCommand(itsCmdNumber, itsDocument, NIL, NIL);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAFields}
-
- PROCEDURE TRevertDocCommand.Fields(PROCEDURE DoToField(fieldName: Str255;
- fieldAddr: Ptr;
- fieldType: INTEGER)); OVERRIDE;
-
- BEGIN
- DoToField('TRevertDocCommand', NIL, bClass);
- INHERITED Fields(DoToField);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAOpen}
-
- PROCEDURE TDocument.IDocument(itsFileType, itsCreator: OSType;
- usesDataFork, usesRsrcFork: BOOLEAN;
- keepsDataOpen, keepsRsrcOpen: BOOLEAN);
-
- VAR
- fi: FailInfo;
-
- PROCEDURE HdlIDocument(error: OSErr;
- message: LONGINT);
-
- BEGIN
- Free;
- END;
-
- BEGIN
- fWindowList := NIL;
- fViewList := NIL;
- fPrintInfo := NIL;
- fDocPrintHandler := NIL;
-
- fDataRefnum := kNoFileRefnum;
- fRsrcRefnum := kNoFileRefnum;
-
- fTitle := NIL;
- fPrintInfo := NIL;
- fSavePrintInfo := FALSE;
- fSharePrintInfo := TRUE;
-
- fVolRefNum := 0;
- fReopenAlert := TRUE;
- fSaveExists := FALSE;
- fCommitOnSave := TRUE;
- fModDate := 0;
-
- fFileType := itsFileType;
- fCreator := itsCreator;
-
- fUsesDataFork := usesDataFork;
- fUsesRsrcFork := usesRsrcFork;
- fDataOpen := keepsDataOpen;
- fRsrcOpen := keepsRsrcOpen;
-
- {$IFC qDebug}
- IF fDataOpen & (NOT fUsesDataFork) THEN
- BEGIN
- Writeln('In TDocument.IDocument: fDataOpen AND NOT fUsesDataFork;');
- Writeln('In TDocument.IDocument: fUsesDataFork := TRUE;');
- fUsesDataFork := TRUE;
- END;
- IF fRsrcOpen & (NOT fUsesRsrcFork) THEN
- BEGIN
- Writeln('In TDocument.IDocument: fRsrcOpen AND NOT fUsesRsrcFork;');
- Writeln('In TDocument.IDocument: fUsesRsrcFork := TRUE;');
- fUsesRsrcFork := TRUE;
- END;
- {$ENDC}
-
- IF keepsDataOpen | keepsRsrcOpen THEN
- fSaveInPlace := sipNever
- ELSE
- fSaveInPlace := sipAskUser;
-
- fDataPerm := fsRdPerm;
- fRsrcPerm := fsRdPerm;
-
- IEvtHandler(gApplication);
-
- CatchFailures(fi, HdlIDocument);
-
- fChangeCount := 0;
-
- fTitle := NewString('');
- FailNil(fTitle);
-
- fWindowList := NewList;
- {$IFC qDebug}
- fWindowList.SetEltType('TWindow');
- {$ENDC}
-
- fViewList := NewList;
- {$IFC qDebug}
- fViewList.SetEltType('TView');
- {$ENDC}
-
- Success(fi);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAClose}
-
- PROCEDURE TDocument.Free; OVERRIDE;
-
- BEGIN
- gApplication.DeleteDocument(SELF);
-
- FreeFile;
-
- fWindowList := FreeListIfObject(fWindowList);
- fViewList := FreeListIfObject(fViewList);
-
- IF fSharePrintInfo THEN
- fPrintInfo := DisposeIfHandle(fPrintInfo);
- fPrintInfo := NIL; { Always drop my reference }
-
- Handle(fTitle) := DisposeIfHandle(fTitle);
-
- INHERITED Free;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAOpen}
-
- PROCEDURE TDocument.AddView(aView: TView);
-
- BEGIN
- { Protect against double installation and keep in synch with window list }
-
- IF (fViewList <> NIL) & (fViewList.GetSameItemNo(aView) = 0) THEN
- fViewList.Insert(aView);
-
- IF (fWindowList <> NIL) & member(aView, TWindow) THEN
- IF fWindowList.GetSameItemNo(aView) = 0 THEN
- fWindowList.Insert(aView);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAWriteFile}
-
- PROCEDURE TDocument.AboutToSave(itsCmd: CmdNumber;
- VAR newName: Str255;
- VAR newVolRefnum: INTEGER;
- VAR makingCopy: BOOLEAN);
-
- BEGIN
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAOpen}
-
- PROCEDURE TDocument.AddWindow(aWindow: TWindow);
-
- BEGIN
- { Protect against double installation and keep in synch with window list }
- IF (fWindowList <> NIL) & (fWindowList.GetSameItemNo(aWindow) = 0) THEN { doesn't already exist in
- list }
- fWindowList.Insert(aWindow);
-
- IF (fViewList <> NIL) & (fViewList.GetSameItemNo(aWindow) = 0) THEN { ??? should we only have one
- list now… maybe created on
- demand? (post 2.0) }
- fViewList.Insert(aWindow);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAFile}
-
- PROCEDURE TDocument.CheckDiskFile(rsrcId, rsrcIndex: INTEGER;
- reverting: BOOLEAN);
-
- VAR
- err: OSErr;
- name: Str255;
- s: Str255;
-
- BEGIN
- err := DiskFileChanged(reverting); {don't care about the file type if saving}
- IF err = errFileChanged THEN
- BEGIN
- name := fTitle^^;
- GetIndString(s, rsrcId, rsrcIndex);
- ParamText(name, s, '', '');
- IF MacAppAlert(phFileChanged, NIL) = cancel THEN {!!! This should be programatically
- defeatable }
- Failure(noErr, msgCancelled);
- END
- {if reverting then we signal an error}
- ELSE IF (err <> noErr) & reverting THEN
- Failure(err, 0);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAClose}
-
- PROCEDURE TDocument.CloseView(aView: TView);
-
- FUNCTION OpenWindowCount: ArrayIndex;
-
- VAR
- openDocWindows: integer;
-
- PROCEDURE CountOpenWindows(aWindow: TWindow);
-
- BEGIN
- IF aWindow.IsShown THEN
- openDocWindows := openDocWindows + 1;
- END;
-
- BEGIN
- { See how many open windows this document has }
- openDocWindows := 0;
- ForAllWindowsDo(CountOpenWindows);
- OpenWindowCount := openDocWindows;
- END;
-
- BEGIN
- IF aView.fDocument = SELF THEN { free window }
- BEGIN
- { !!! Yuch!, of course we should be able to ASK any view if it would like to close
- its associated document and maybe even what doc it would like to close.
- Some other time… }
- IF (Member(aView, TWindow) & (TWindow(aView).fClosesDocument) | (OpenWindowCount <= 1)) THEN
- Close { The view will be closed and freed as a side effect }
- ELSE
- aView.Close;
- END;
- END;
-
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAClose}
-
- PROCEDURE TDocument.Close;
-
- VAR
- lastCommand: TCommand;
- poseResult: INTEGER;
- changeCount: LONGINT;
-
- {Must never be called for a document related to a view in the Clipboard.
- Why is this???}
-
- PROCEDURE CloseAWindow(aWindow: TWindow);
-
- BEGIN
- aWindow.Close
- END;
-
- BEGIN
- {$IFC qDebug}
- IF gClipWindow.fDocument = SELF THEN
- ProgramBreak('Attempt to close clipboard document');
- {$ENDC}
-
- changeCount := GetChangeCount;
- IF changeCount <> 0 THEN
- BEGIN
- poseResult := PoseSaveDialog;
- CASE poseResult OF
- cancel:
- Failure(noErr, msgCancelled);
- END;
- END;
-
- lastCommand := GetLastCommand;
- IF (lastCommand <> NIL) & (lastCommand.fChangedDocument = SELF) THEN
- CommitLastCommand;
-
- IF changeCount <> 0 THEN
- BEGIN
- CASE poseResult OF
- kYesButton:
- {Will fail if unable to save}
- Save(cClose, {askForFilename:} NOT fSaveExists,
- kSwitchToTarget);
- kNoButton:
- Abandon;
- END;
- END;
-
- ForAllWindowsDo(CloseAWindow);
-
- Free;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAClose}
-
- PROCEDURE TDocument.DeleteView(viewToDelete: TView);
-
- BEGIN
- IF (fViewList <> NIL) THEN
- fViewList.Delete(viewToDelete);
-
- IF (fWindowList <> NIL) THEN
- fWindowList.Delete(viewToDelete); { Make sure the lists are in synch. ???
- should we only have one list now (post
- 2.0) }
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAClose}
-
- PROCEDURE TDocument.DeleteWindow(windowToDelete: TWindow);
-
- BEGIN
- IF (fWindowList <> NIL) THEN
- fWindowList.Delete(windowToDelete);
-
- IF (fViewList <> NIL) THEN
- fViewList.Delete(windowToDelete); { Make sure the lists are in synch. ???
- should we only have one list now (post
- 2.0) }
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAFile}
-
- FUNCTION TDocument.DiskFileChanged(checkType: BOOLEAN): OSErr;
-
- VAR
- pb: HParamBlockRec;
- err: OSErr;
- fi: FailInfo;
-
- PROCEDURE HdlGetFileInfo(error: OSErr;
- message: LONGINT);
-
- BEGIN
- Free;
- END;
-
- BEGIN
- IF fSaveExists THEN
- BEGIN
- CatchFailures(fi, HdlGetFileInfo);
- LockHandleHigh(Handle(fTitle));
- {$Push} {$H-}
- err := GetFileInfo(fTitle^^, fVolRefNum, pb);
- {$Pop}
- HUnLock(Handle(fTitle));
- Success(fi);
- IF (err = noErr) & checkType & (pb.ioFlFndrInfo.fdType <> fFileType) THEN
- err := errFTypeChanged
- ELSE IF pb.ioFlMdDat <> fModDate THEN
- err := errFileChanged;
- DiskFileChanged := err;
- END
- ELSE
- DiskFileChanged := noErr;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAOpen}
-
- PROCEDURE TDocument.DoInitialState;
- {Called for 'New' & 'Revert' [to blank] commands & for default open tool icon}
-
- BEGIN
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAOpen}
-
- PROCEDURE TDocument.DoMakeViews(forPrinting: BOOLEAN);
-
- { E X A M P L E
- VAR aYOURView: TYOURView;
- BEGIN
- NEW(aYOURView);
- aYOURView.IYOURView(SELF, YOURExtentRect);
- DoMakeView := aYOURView;
- END;
- }
-
- VAR
- aPrintHandler: TPrintHandler;
- aView: TView;
-
- BEGIN
- IF qTemplateViews THEN
- BEGIN
- IF forPrinting THEN { Don't need window when Finder printing. }
- aView := DoCreateViews(SELF, NIL, kDefaultViewID, gZeroVPt)
- ELSE
- aView := NewTemplateWindow(kDefaultWindowID, SELF);
- FailNil(aView);
-
- { Install a copy of gPrintHandler into the view. gPrintHandler will be a real printhandler
- if UPrinting has been initialized otherwise it is a null print handler. }
- aView := aView.FindSubView(kIDDefaultView);
- aPrintHandler := TPrintHandler(gPrintHandler.clone);
- fDocPrintHandler := aPrintHandler;
- aPrintHandler.fDocument := SELF;
- aPrintHandler.fView := aView;
- aPrintHandler.SetDefaultPrintInfo;
- aView.AttachPrintHandler(aPrintHandler);
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MADocumentRes}
-
- PROCEDURE TDocument.DoMakeWindows;
-
- BEGIN
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MASelCommand}
-
- FUNCTION TDocument.DoMenuCommand(aCmdNumber: CmdNumber): TCommand;
-
- VAR
- aSaveDocCommand: TSaveDocCommand;
- aRevertDocCommand: TRevertDocCommand;
- oldObjectPerm: BOOLEAN;
-
- BEGIN
- { ==================================================================================
- Some commands will be returned to perform actions that must _ALWAYS_ be available.
- The allocation cannot be allowed to fail. So we do a temp allocation which by
- definition cannot be allowed to fail. This strategy is used wherever we want to use
- command objects but don't want to leave the user twisting in the breeze.
- NOTE: Don't forget to allow for this memory in your mem! resource if you copy this
- style in your own code.
- ================================================================================== }
-
- DoMenuCommand := NIL;
-
- CASE aCmdNumber OF
-
- cPrFileBase..cPrFileMax:
- IF fDocPrintHandler <> NIL THEN
- DoMenuCommand := fDocPrintHandler.DoMenuCommand(aCmdNumber);
-
- cSave, cSaveAs, cSaveCopy:
- BEGIN
- oldObjectPerm := AllocateObjectsFromPerm(FALSE);
- New(aSaveDocCommand);
- IF AllocateObjectsFromPerm(oldObjectPerm) THEN;
-
- FailNil(aSaveDocCommand); { just in case }
- aSaveDocCommand.ISaveDocCommand(aCmdNumber, SELF);
- DoMenuCommand := aSaveDocCommand;
- END;
-
- cRevert:
- BEGIN
- oldObjectPerm := AllocateObjectsFromPerm(FALSE);
- New(aRevertDocCommand);
- IF AllocateObjectsFromPerm(oldObjectPerm) THEN;
-
- FailNil(aRevertDocCommand); { just in case }
- aRevertDocCommand.IRevertDocCommand(aCmdNumber, SELF);
- DoMenuCommand := aRevertDocCommand;
- END;
-
- OTHERWISE
- DoMenuCommand := INHERITED DoMenuCommand(aCmdNumber);
- END; {CASE}
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAWriteFile}
-
- PROCEDURE TDocument.DoNeedDiskSpace(VAR dataForkBytes, rsrcForkBytes: LONGINT);
-
- BEGIN
- IF fSavePrintInfo THEN
- dataForkBytes := dataForkBytes + kPrintInfoSize;
- IF fUsesRsrcFork THEN
- rsrcForkBytes := rsrcForkBytes + kRsrcFileOverhead;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAReadFile}
-
- PROCEDURE TDocument.DoRead(aRefNum: INTEGER;
- rsrcExists, forPrinting: BOOLEAN);
-
- VAR
- count: LONGINT;
-
- BEGIN
- IF fSavePrintInfo THEN
- BEGIN
- IF fPrintInfo = NIL THEN
- BEGIN
- fPrintInfo := NewPermHandle(kPrintInfoSize);
- FailNil(fPrintInfo);
- END;
-
- count := kPrintInfoSize;
- FailOSerr(FSRead(aRefNum, count, fPrintInfo^));
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MADocumentRes}
-
- PROCEDURE TDocument.DoSetupMenus;
-
- BEGIN
- INHERITED DoSetupMenus;
-
- Enable(cSaveAs, TRUE);
- Enable(cSaveCopy, TRUE);
- IF GetChangeCount <> 0 THEN
- BEGIN
- Enable(cSave, TRUE);
- Enable(cRevert, TRUE);
- END;
-
- IF (fDocPrintHandler <> NIL) & (NOT gTarget.HandlesPrintingCommands) THEN
- fDocPrintHandler.DoSetupMenus;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAWriteFile}
-
- PROCEDURE TDocument.DoWrite(aRefNum: INTEGER;
- makingCopy: BOOLEAN);
-
- VAR
- count: LONGINT;
-
- BEGIN
- IF fSavePrintInfo THEN
- BEGIN
- IF fPrintInfo = NIL THEN
- BEGIN
- {$IFC qDebug}
- ProgramBreak('no print record in document') {???}
- {$ENDC}
- END
- ELSE
- BEGIN
- count := kPrintInfoSize;
- FailOSerr(FSWrite(aRefNum, count, fPrintInfo^));
- END;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MADocumentRes}
-
- PROCEDURE TDocument.ForAllViewsDo(PROCEDURE DoToView(aView: TView));
-
- BEGIN
- IF (fViewList <> NIL) THEN
- fViewList.Each(DoToView);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MADocumentRes}
-
- PROCEDURE TDocument.ForAllWindowsDo(PROCEDURE DoToWind(aWindow: TWindow));
-
- BEGIN
- IF (fWindowList <> NIL) THEN
- fWindowList.Each(DoToWind);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MADocumentRes}
-
- PROCEDURE TDocument.FreeData;
-
- BEGIN
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MADocumentRes}
-
- PROCEDURE TDocument.FreeFile;
-
- VAR
- err: OSErr;
-
- BEGIN
- IF fDataOpen | fRsrcOpen THEN
- BEGIN
- err := CloseFile(fDataRefnum, fRsrcRefnum);
- {$IFC qDebug}
- IF err <> noErr THEN
- Writeln('In TDocument.FreeFile: error from CloseFile = ', err: 1);
- {$ENDC}
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAClipboard}
-
- PROCEDURE TDocument.FreeFromClipboard;
-
- BEGIN
- DeleteWindow(gClipWindow);
-
- Free;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MADocumentRes}
-
- FUNCTION TDocument.GetChangeCount: LONGINT;
-
- BEGIN
- GetChangeCount := fChangeCount;
- END;
-
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAInspector}
-
- PROCEDURE TDocument.GetInspectorName(VAR inspectorName: Str255); OVERRIDE;
-
- BEGIN
- inspectorName := fTitle^^;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAWriteFile}
-
- FUNCTION TDocument.GetSaveInfo(itsCmdNumber: CmdNumber;
- copyFInfo: BOOLEAN;
- VAR cInfo: CInfoPBRec): BOOLEAN;
-
- VAR
- currName: Str255;
- err: OSErr;
-
- BEGIN
- IF fSaveExists & copyFInfo THEN
- BEGIN
- currName := fTitle^^;
- WITH cInfo DO
- BEGIN
- ioNamePtr := @currName;
- ioVRefnum := fVolRefNum;
- ioFVersNum := 0;
- ioFDirIndex := 0;
- ioDirID := 0;
- END;
- IF qNeedsROM128K | gConfiguration.hasHFS THEN
- BEGIN
- err := FillInDirID(@cInfo);
- IF err = noErr THEN
- err := PBGetCatInfo(@cInfo, FALSE);
- END
- ELSE
- err := PBGetFInfo(@cInfo, FALSE);
-
- cInfo.ioNamePtr := NIL; {since ptr is invalid when we exit}
-
- {set the type and creator in case it has changed;
- the file might be on a file server and someone else
- could have changed the document}
- cInfo.ioFlFndrInfo.fdCreator := fCreator;
- cInfo.ioFlFndrInfo.fdType := fFileType;
- END
- ELSE
- err := fnfErr; {fake error}
-
- IF err = noErr THEN
- GetSaveInfo := TRUE
- ELSE
- BEGIN
- WITH cInfo.ioFlFndrInfo DO
- BEGIN
- fdCreator := fCreator;
- fdType := fFileType;
- END;
-
- GetSaveInfo := FALSE
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAFile}
-
- PROCEDURE TDocument.GetTempName(VAR filename: Str255);
-
- CONST
- maxName = 31; {maximum name size to generate}
- maxNumber = 10; {maximum # digits of the random number}
- maxPrefix = maxName - maxNumber;
-
- VAR
- s: Str255;
- apRefnum: INTEGER;
- apParam: Handle;
- time: LONGINT;
-
- BEGIN
- {If the document is untitled, use the application name.}
- IF fTitle^^ = '' THEN
- GetAppParms(filename, apRefnum, apParam)
- ELSE
- filename := fTitle^^;
-
- IF Length(filename) > maxPrefix THEN
- filename := Copy(filename, 1, maxPrefix);
-
- {append a pseudo-random number}
- GetDateTime(time);
- NumToString(ABS(BXOR(time, BRotR(TickCount, 16))), s);
- filename := CONCAT(filename, s);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MADocumentRes}
-
- FUNCTION TDocument.HandlesPrintingCommands: BOOLEAN; OVERRIDE;
-
- BEGIN
- HandlesPrintingCommands := FALSE;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAWriteFile}
-
- PROCEDURE TDocument.MakeNewCopy(makingCopy: BOOLEAN;
- validFInfo: BOOLEAN;
- VAR cInfo: CInfoPBRec);
-
- {This routine changes the following fields of cInfo:
-
- The ioNamePtr, and ioVRefnum fields must be set to indicate
- the desired file; this routine sets ioDirID to 0.
-
- IF setFInfo is TRUE then all the fields of cInfo
- should be set up. Otherwise only the file type and creator
- need to be set up.}
-
- VAR
- err: OSErr;
- dataRefnum: INTEGER;
- rsrcRefnum: INTEGER;
- oldVRefnum: INTEGER;
- fi: FailInfo;
-
- PROCEDURE HdlMkNewCopy(error: OSErr;
- message: LONGINT);
-
- VAR
- err: OSErr;
-
- BEGIN
- err := CloseFile(dataRefnum, rsrcRefnum);
- {$IFC qDebug}
- IF err <> noErr THEN
- Writeln('In HdlMkNewCopy: error from CloseFile is ', err: 1);
- {$ENDC}
-
- err := DeleteFile(cInfo.ioNamePtr, cInfo.ioVRefnum);
- {$IFC qDebug}
- IF (err <> noErr) & (err <> fnfErr) THEN
- Writeln('In HdlMkNewCopy: error from DeleteFile is ', err: 1);
- {$ENDC}
- END;
-
- BEGIN
- IF fUsesDataFork | fUsesRsrcFork THEN
- BEGIN
- cInfo.ioDirID := 0;
-
- {Initalize these in case we fail before the call to OpenAFile.}
- dataRefnum := kNoFileRefnum;
- rsrcRefnum := kNoFileRefnum;
-
- {Create the file with the desired creator/type,
- in case we are not going to set the file info
- below.}
- FailOSerr(Create(cInfo.ioNamePtr^, cInfo.ioVRefnum, cInfo.ioFlFndrInfo.fdCreator,
- cInfo.ioFlFndrInfo.fdType));
-
- CatchFailures(fi, HdlMkNewCopy);
-
- IF fUsesRsrcFork THEN
- BEGIN
- FailOSerr(GetVol(NIL, oldVRefnum));
- FailOSerr(SetVol(NIL, cInfo.ioVRefnum));
-
- CreateResFile(cInfo.ioNamePtr^);
-
- {Do this here to ensure that the current volume is
- reset, even if we fail.}
- FailOSerr(SetVol(NIL, oldVRefnum));
-
- FailResError; {this checks the call to CreateResFile}
- END;
-
- IF validFInfo & (NOT makingCopy) THEN
- BEGIN
- IF qNeedsROM128K | gConfiguration.hasHFS THEN
- FailOSerr(PBSetCatInfo(@cInfo, FALSE)) {??? Poor Man's Search Path ???}
- ELSE
- BEGIN
- {NOTE: We can use the cInfo for this call since the
- fields required by PBSetInfo are a subset of
- those in the CInfoPBRec; except we set the
- ioFVersNum field (just in case)}
- cInfo.ioFVersNum := 0;
- FailOSerr(PBSetFInfo(@cInfo, FALSE));
- END;
- END;
-
- FailOSerr(OpenAFile(cInfo.ioNamePtr^, cInfo.ioVRefnum, fUsesDataFork, fUsesRsrcFork,
- fsRdWrPerm, fsRdWrPerm, dataRefnum, rsrcRefnum));
-
- DoWrite(dataRefnum, makingCopy);
-
- Success(fi);
-
- FailOSerr(CloseFile(dataRefnum, rsrcRefnum));
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAFile}
-
- FUNCTION TDocument.OpenAFile(name: Str255;
- volRefnum: INTEGER;
- openData, openRsrc: BOOLEAN;
- dataPerm, rsrcPerm: INTEGER;
- VAR dataRefnum, rsrcRefnum: INTEGER): OSErr;
-
- BEGIN
- OpenAFile := MAOpenFile(name, volRefnum, openData, openRsrc, dataPerm, rsrcPerm, dataRefnum,
- rsrcRefnum);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAOpen}
-
- PROCEDURE TDocument.OpenAgain(itsCmdNumber: CmdNumber;
- openingDoc: TDocument);
-
- VAR
- window: TWindow;
- s: Str255;
-
- BEGIN
- s := fTitle^^; { because ParamText allocates memory }
- ParamText(s, '', '', '');
-
- IF fReopenAlert THEN
- StdAlert(phReopenDoc); {!!! This should be programatically
- defeatable }
-
- IF (fWindowList <> NIL) THEN
- BEGIN
- window := TWindow(fWindowList.First); {??? this seems funky }
- window.Select;
- END;
-
- Failure(0, 0);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAClose}
-
- FUNCTION TDocument.PoseSaveDialog: INTEGER;
-
- VAR
- idx: INTEGER;
- name: Str255;
- reason: Str255;
-
- BEGIN
- IF GetChangeCount <> 0 THEN
- BEGIN
- IF gAppDone THEN
- idx := bzQuitting
- ELSE
- idx := bzClosing;
-
- GetIndString(reason, kIDBuzzString, idx);
- name := fTitle^^; { ParamText can compact heap }
- ParamText(name, reason, '', '');
-
- PoseSaveDialog := MacAppAlert(phSaveChanges, NIL); {!!! This should be programatically
- defeatable }
- END
- ELSE
- PoseSaveDialog := kNoButton;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAReadFile}
-
- PROCEDURE TDocument.ReadFromFile(VAR anAppFile: AppFile;
- forPrinting: BOOLEAN);
-
- VAR
- fi: FailInfo;
- dataRefnum: INTEGER;
- rsrcRefnum: INTEGER;
- isRevert: BOOLEAN;
- shouldOpenData: BOOLEAN;
- shouldOpenRsrc: BOOLEAN;
-
- PROCEDURE HdlRead(error: INTEGER;
- message: LONGINT);
-
- VAR
- err: INTEGER;
-
- BEGIN
- err := CloseFile(dataRefnum, rsrcRefnum);
- {$IFC qDebug}
- IF err <> noErr THEN
- Writeln('In HdlOpen: error from CloseFile is ', err: 1);
- {$ENDC}
-
- {caller should set the message as appropriate}
- END;
-
- BEGIN
- isRevert := (anAppFile.fName = ''); {signal to re-read file}
- IF isRevert THEN
- BEGIN
- anAppFile.fName := fTitle^^;
- anAppFile.vRefnum := fVolRefNum;
- END
- ELSE
- BEGIN
- SetString(fTitle, anAppFile.fName);
- IF fTitle^^ <> anAppFile.fName THEN { ??? how to test if SetString worked ??? }
- FailOSerr(memFullErr);
- fVolRefNum := anAppFile.vRefnum;
- END;
-
- {Don't attempt to open the fork(s) again if they're already open.
- We do all this rather than close and reopen so that we need not
- search the directory again, an expensive operation on large MFS
- disks.}
- shouldOpenData := fUsesDataFork & NOT (fDataOpen & isRevert);
- shouldOpenRsrc := fUsesRsrcFork & NOT (fRsrcOpen & isRevert);
-
- {Make sure CloseFile operates properly if OpenAFile fails.}
- dataRefnum := kNoFileRefnum;
- rsrcRefnum := kNoFileRefnum;
-
- CatchFailures(fi, HdlRead);
-
- FailOSerr(OpenAFile(anAppFile.fName, anAppFile.vRefnum, shouldOpenData, shouldOpenRsrc,
- fDataPerm, fRsrcPerm, dataRefnum, rsrcRefnum));
-
- fSaveExists := TRUE;
-
- {If the file is already open, use the refnums we already have.
- Make sure that the document's data fork is positioned at TOF.
- Make sure that the document's resource file is on top.}
- IF fDataOpen & NOT shouldOpenData THEN
- BEGIN
- dataRefnum := fDataRefnum;
- FailOSerr(SetFPos(dataRefnum, fsFromStart, 0));
- END;
- IF fRsrcOpen & NOT shouldOpenRsrc THEN
- BEGIN
- rsrcRefnum := fRsrcRefnum;
- UseResFile(rsrcRefnum);
- END;
-
- DoRead(dataRefnum, {rsrcExists:} rsrcRefnum <> kNoFileRefnum,
- forPrinting);
-
- SetChangeCount(0);
-
- Success(fi);
-
- IF fDataOpen THEN
- BEGIN
- fDataRefnum := dataRefnum; {save valid refnum}
- dataRefnum := kNoFileRefnum; {make sure CloseFile doesn't close it}
- END
- ELSE
- fDataRefnum := kNoFileRefnum; {save the no file refnum}
-
- IF fRsrcOpen THEN
- BEGIN
- fRsrcRefnum := rsrcRefnum; {save valid refnum}
- UseResFile(fRsrcRefnum); {make sure it is the current map}
- rsrcRefnum := kNoFileRefnum; {make sure CloseFile doesn't close it}
- END
- ELSE
- fRsrcRefnum := kNoFileRefnum; {save the no file refnum}
-
- FailOSerr(CloseFile(dataRefnum, rsrcRefnum));
-
- fModDate := FileModDate(anAppFile.fName, anAppFile.vRefnum);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAWriteFile}
-
- PROCEDURE TDocument.RequestFileName(itsCmdNumber: CmdNumber;
- makingCopy: BOOLEAN;
- VAR filename: Str255;
- VAR volRefnum: INTEGER);
-
- VAR
- reply: SFReply;
- dlgID: INTEGER;
- prompt: Str255;
- dlgLoc: Point;
- dlgHook: ProcPtr;
- filterProc: ProcPtr;
- otherDoc: TDocument;
- err: OSErr;
-
- BEGIN
- filename := fTitle^^;
- SFPutParms(itsCmdNumber, dlgID, dlgLoc, filename, prompt, dlgHook, filterProc);
-
- {$IFC qDebug}
- gRsrcCheck := 0; {force immediate check}
- {$ENDC}
-
- {Update all the windows to avoid a bug in Standard File in which
- you can't mount a disk correctly when window updates are pending.}
- gApplication.UpdateAllWindows;
-
- SFPPutFile(dlgLoc, prompt, filename, dlgHook, reply, dlgID, filterProc);
-
- IF reply.good THEN
- BEGIN
- filename := reply.fName;
- volRefnum := reply.vRefnum;
-
- {See if there is an open document with the same name. If there
- is, tell it we're trying to save it again, which will
- ordinarily result in failure.}
- otherDoc := gApplication.AlreadyOpen(filename, volRefnum);
- IF otherDoc <> NIL THEN
- otherDoc.SaveAgain(itsCmdNumber, makingCopy, SELF);
-
- {User has already confirmed deleting target in this case,
- so trash file and get maximum disk space.}
- err := DeleteFile(@filename, volRefnum);
- IF (err <> noErr) & (err <> fnfErr) THEN
- Failure(err, 0);
- END
- ELSE
- Failure(noErr, msgCancelled); {user cancelled}
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAReadFile}
-
- PROCEDURE TDocument.Revert;
-
- VAR
- anAppFile: AppFile;
- fi: FailInfo;
- lastCommand: TCommand;
-
- PROCEDURE HdlRevert(error: OSErr;
- message: LONGINT);
-
- BEGIN
- IF error = fnfErr THEN
- error := errRevertFNF;
- IF message = 0 THEN
- gErrorParm3 := fTitle^^;
- FailNewMessage(error, message, msgRevertFailed);
- END;
-
- PROCEDURE ResetPrintHandler(view: TView);
-
- BEGIN
- IF view.fPrintHandler <> NIL THEN
- view.fPrintHandler.Reset;
- END;
-
- BEGIN
- CatchFailures(fi, HdlRevert);
-
- CheckDiskFile(kIDBuzzString, bzRevertAnyways, {reverting:} TRUE);
-
- lastCommand := GetLastCommand;
- IF (lastCommand <> NIL) & (lastCommand.fChangedDocument = SELF) THEN
- CommitLastCommand;
-
- FreeData;
-
- IF fSaveExists THEN
- BEGIN
- anAppFile.fName := ''; {signal that we are reverting}
- ReadFromFile(anAppFile, kForDisplay);
- END
- ELSE
- BEGIN
- IF (fViewList <> NIL) THEN
- fViewList.Each(ResetPrintHandler);
- DoInitialState;
- END;
-
- SetChangeCount(0);
-
- Success(fi);
- END;
-
- {Notes:
- Parameter combinations:
- ask? copy?
- T F Save As... or Save of Untitled doc
- T T Save a Copy In...
- F F Save of a titled doc
-
- Caller is responsible for passing askForFilename = TRUE
- if the document is currently untitled.
-
- If askForFilename is FALSE, we force switchToTarget to TRUE.
-
- We call SaveInPlace only if there is insufficient disk space
- to save a temporary copy and we are allowed to save in
- place (according to the fSaveInPlace field).
-
- If askForFilename is TRUE, SaveInPlace should not be called
- since we delete the target immediately. (If there is not
- enough room to save via a temporary file, we would not
- be able to save in place either.)
- }
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAReadFile}
-
- PROCEDURE TDocument.Abandon;
-
- BEGIN
- { If your document needs to do some cleanup when its being abandoned then
- put some code in an override of this method }
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAWriteFile}
-
- PROCEDURE TDocument.Save(itsCmdNumber: CmdNumber;
- askForFilename, makingCopy: BOOLEAN);
-
- VAR
- name: Str255;
- volRefnum: INTEGER;
-
- hPB: HParamBlockRec;
-
- dataBytes: LONGINT;
- rsrcBytes: LONGINT;
- neededBlks: LONGINT;
- usedBlks: LONGINT;
- freeBlks: LONGINT;
- blkSize: LONGINT;
-
- copyFInfo: BOOLEAN;
- canSaveInPlace: BOOLEAN;
- oldFlag: BOOLEAN;
- fi: FailInfo;
- err: OSErr;
-
- otherDoc: TDocument;
- lastCommand: TCommand;
-
- PROCEDURE HdlSave(error: INTEGER;
- message: LONGINT);
-
- VAR
- newMsg: LONGINT;
-
- BEGIN
- err := FlushVol(NIL, volRefnum);
-
- IF message = 0 THEN
- gErrorParm3 := name;
-
- IF NOT askForFilename THEN
- newMsg := msgSaveFailed
- ELSE IF makingCopy THEN
- newMsg := msgSaveCopyFailed
- ELSE
- newMsg := msgSaveAsFailed;
-
- FailNewMessage(error, message, newMsg);
- END;
-
- BEGIN
- CatchFailures(fi, HdlSave);
-
- {Step 1: Get the target of the save}
- {Caller should set askForFilename if this is an Untitled document}
- IF askForFilename THEN
- RequestFileName(itsCmdNumber, makingCopy, name, volRefnum)
- ELSE
- BEGIN
- name := fTitle^^;
- volRefnum := fVolRefNum;
- END;
-
- {Step 2: Decide whether to save with a temporary file or in place,
- and call appropriate method (SaveViaTemp or SaveInPlace).}
-
- copyFInfo := NOT (askForFilename | makingCopy);
-
- IF copyFInfo THEN
- CheckDiskFile(kIDBuzzString, bzSaveAnyways, {reverting:} FALSE);
-
- AboutToSave(itsCmdNumber, name, volRefnum, makingCopy);
-
- lastCommand := GetLastCommand;
- IF fCommitOnSave | (NOT makingCopy) & (lastCommand <> NIL) & (lastCommand.fChangedDocument =
- SELF) THEN
- CommitLastCommand;
-
- {Get information about the volume saving to}
- WITH hPB DO
- BEGIN
- ioNamePtr := NIL;
- ioVRefnum := volRefnum;
- ioVolIndex := 0;
- END;
- FailOSerr(PBHGetVInfo(@hPB, FALSE));
-
- {on HFS ioVFrBlk is an unsigned INTEGER; on MFS it is
- limited to a positive signed INTEGER}
- freeBlks := BAND(hPB.ioVFrBlk, $0000FFFF) - 1; {-1 for some slop -- don't try to fill up
- the disk completely}
-
- {compute size needed to save document}
- blkSize := hPB.ioVAlBlkSiz;
-
- dataBytes := 0;
- rsrcBytes := 0;
- DoNeedDiskSpace(dataBytes, rsrcBytes);
- neededBlks := NumBlocks(rsrcBytes, blkSize) + NumBlocks(dataBytes, blkSize);
-
- IF freeBlks >= neededBlks THEN
- {enough disk space to create a second copy of document}
- SaveViaTemp(itsCmdNumber, makingCopy, copyFInfo, name, volRefnum)
- ELSE
- BEGIN {cannot make a duplicate of document}
- {Check to see if we can save the file in place.}
-
- canSaveInPlace := FALSE; {default value}
-
- IF fSaveInPlace <> sipNever THEN
- BEGIN
- {See if target exists, if the disk space it uses is
- enough to allow us to save the file after deleting it.}
- err := GetFileInfo(name, volRefnum, hPB);
-
- IF err = noErr THEN
- BEGIN
- {compute # block used by target}
- usedBlks := NumBlocks(hPB.ioFlRPyLen, blkSize) + NumBlocks(hPB.ioFlPyLen, blkSize);
-
- IF neededBlks <= usedBlks + freeBlks THEN
- {we could save if target is deleted first}
- BEGIN
- IF fSaveInPlace = sipAskUser THEN
- BEGIN
- ParamText(name, '', '', '');
- IF MacAppAlert(phPurgeOld, NIL) = kYesButton THEN {!!! This should be
- programatically
- defeatable }
- canSaveInPlace := TRUE
- ELSE
- Failure(noErr, msgCancelled);
- END
- ELSE {we know fSaveInPlace <> sipNever; it must
- be sipAlways}
- canSaveInPlace := TRUE;
- END;
- END
- ELSE IF err <> fnfErr THEN
- Failure(err, 0);
- END;
-
- IF canSaveInPlace THEN
- SaveInPlace(itsCmdNumber, makingCopy, copyFInfo, name, volRefnum)
- ELSE
- Failure(dskFulErr, 0);
- END;
-
- Success(fi); {??? Put later in proc ???}
-
- {$IFC qDebug}
- err := GetFileInfo(name, volRefnum, hPB);
- IF err = noErr THEN
- BEGIN
- usedBlks := NumBlocks(hPB.ioFlRPyLen, blkSize) + NumBlocks(hPB.ioFlPyLen, blkSize);
- IF usedBlks <> neededBlks THEN
- BEGIN
- Writeln('In TDocument.Save: DoNeedDiskSpace estimated disk space incorrectly.');
- Writeln('estimated # disk blocks = ', neededBlks: 1);
- Writeln(' actual # disk blocks = ', usedBlks: 1);
- END;
- END;
- {$ENDC}
-
- {Step 3: Tell the document that the save was successful.}
- IF NOT makingCopy THEN
- SavedOn(name, volRefnum);
-
- err := FlushVol(NIL, volRefnum);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAWriteFile}
-
- PROCEDURE TDocument.SaveAgain(itsCmdNumber: CmdNumber;
- makingCopy: BOOLEAN;
- savingDoc: TDocument);
-
- BEGIN
- {Don't save the file if another one of the same name is already open.}
- IF savingDoc <> SELF THEN
- Failure(errSaveAgain, 0);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAWriteFile}
-
- PROCEDURE TDocument.SavedOn(VAR filename: Str255;
- volRefnum: INTEGER);
-
- VAR
- dataRefnum: INTEGER;
- rsrcRefnum: INTEGER;
-
- BEGIN
- SetChangeCount(0);
- fSaveExists := TRUE;
-
- IF fTitle^^ <> filename THEN
- SetTitle(filename);
- fVolRefNum := volRefnum;
-
- fModDate := FileModDate(filename, volRefnum);
-
- FailOSerr(OpenAFile(filename, volRefnum, fDataOpen, fRsrcOpen, fDataPerm, fRsrcPerm, dataRefnum,
- rsrcRefnum));
- fDataRefnum := dataRefnum;
- fRsrcRefnum := rsrcRefnum;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAWriteFile}
-
- PROCEDURE TDocument.SaveInPlace(itsCmdNumber: CmdNumber;
- makingCopy, copyFInfo: BOOLEAN;
- VAR filename: Str255;
- volRefnum: INTEGER);
- {fileName is VAR only to avoid copying}
-
- VAR
- cInfo: CInfoPBRec;
- validInfo: BOOLEAN;
- err: OSErr;
-
- BEGIN
- IF NOT (fDataOpen | fRsrcOpen) THEN
- BEGIN
- validInfo := GetSaveInfo(itsCmdNumber, copyFInfo, cInfo);
-
- {Tell document that the file is going away.}
- FreeFile;
-
- {Delete the current file.}
- err := DeleteFile(@filename, volRefnum);
- IF (err <> noErr) & (err <> fnfErr) THEN
- Failure(err, 0);
-
- {Save a new copy.}
- cInfo.ioNamePtr := @filename;
- cInfo.ioVRefnum := volRefnum;
-
- MakeNewCopy(makingCopy, validInfo, cInfo);
- END
- ELSE
- BEGIN
- {$IFC qDebug}
- ProgramBreak('You must override TDocument.SaveInPlace for a disk-based document.');
- {$ENDC}
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAWriteFile}
-
- PROCEDURE TDocument.SaveViaTemp(itsCmdNumber: CmdNumber;
- makingCopy, copyFInfo: BOOLEAN;
- VAR filename: Str255;
- volRefnum: INTEGER);
- {fileName is VAR only to avoid copying}
-
- VAR
- cInfo: CInfoPBRec;
- validInfo: BOOLEAN;
- tmpName: Str255;
- fi: FailInfo;
- err: OSErr;
-
- PROCEDURE HdlSvTemp(error: OSErr;
- message: LONGINT);
-
- VAR
- err: OSErr;
-
- BEGIN
- err := DeleteFile(@tmpName, volRefnum);
- {$IFC qDebug}
- IF (err <> noErr) & (err <> fnfErr) THEN
- Writeln('In HdlSvTemp: error from DeleteFile is ', err: 1);
- {$ENDC}
- END;
-
- PROCEDURE HdlSaveFailed(error: OSErr;
- message: LONGINT);
-
- VAR
- dataRefnum: INTEGER;
- rsrcRefnum: INTEGER;
- fi: FailInfo;
-
- {If reopen attempt fails, make sure original error gets through.}
-
- PROCEDURE HdlFailFailed(newError: OSErr;
- newMessage: LONGINT);
-
- BEGIN
- Failure(error, message);
- END;
-
- BEGIN
- HdlSvTemp(error, message);
- IF fSaveExists & (NOT makingCopy) THEN
- BEGIN
- CatchFailures(fi, HdlFailFailed);
- LockHandleHigh(Handle(fTitle));
- FailOSerr(OpenAFile(fTitle^^, fVolRefNum, fDataOpen, fRsrcOpen, fDataPerm, fRsrcPerm,
- dataRefnum, rsrcRefnum));
- HUnLock(Handle(fTitle));
- Success(fi);
- fDataRefnum := dataRefnum;
- fRsrcRefnum := rsrcRefnum;
- END;
- END;
-
- BEGIN
- validInfo := GetSaveInfo(itsCmdNumber, copyFInfo, cInfo);
-
- GetTempName(tmpName);
-
- cInfo.ioNamePtr := @tmpName;
- cInfo.ioVRefnum := volRefnum;
-
- MakeNewCopy(makingCopy, validInfo, cInfo);
-
- CatchFailures(fi, HdlSvTemp);
-
- {Tell document that the file is going away}
- IF NOT makingCopy THEN
- FreeFile;
-
- Success(fi);
-
- CatchFailures(fi, HdlSaveFailed);
-
- {Delete the old copy if it exists.}
- err := DeleteFile(@filename, volRefnum);
- IF (err <> noErr) & (err <> fnfErr) THEN
- Failure(err, 0);
-
- FailOSerr(Rename(tmpName, volRefnum, filename));
-
- Success(fi);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MADocumentRes}
-
- PROCEDURE TDocument.SetTitle(aTitle: Str255);
-
- PROCEDURE InstallTitle(aWindow: TWindow);
-
- BEGIN
- aWindow.SetTitleForDoc(aTitle);
- END;
-
- BEGIN
- SetString(fTitle, aTitle);
- IF fTitle^^ <> aTitle THEN { ??? how to test if SetString worked ??? }
- FailOSerr(memFullErr);
- ForAllWindowsDo(InstallTitle);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MADocumentRes}
-
- PROCEDURE TDocument.SetChangeCount(newChangeCount: LONGINT);
-
- { (??? should we add this as a default action with a TView.DocumentChanged method?)
- You can notify your views that the document changed something like this:
- PROCEDURE NotifyChange(aView: TView);
-
- BEGIN
- if Member(aView, TMyClass) THEN
- TMyView(aView).DocumentChanged(newChangeCount);
- END;
- }
-
- BEGIN
- fChangeCount := newChangeCount;
- { ForAllViewsDo(NotifyChange); }
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAWriteFile}
-
- PROCEDURE TDocument.SFPutParms(itsCmdNumber: CmdNumber;
- VAR dlgID: INTEGER;
- VAR where: Point;
- VAR defaultName, prompt: Str255;
- VAR dlgHook, filterProc: ProcPtr);
-
- VAR
- dlogTemplate: DialogTHndl;
- dialogRect: Rect;
- idx: INTEGER;
-
- BEGIN
- dlgID := putDlgID; {putDlgID defined by Standard File}
-
- { compute the top-left location of the dialog }
- dlogTemplate := DialogTHndl(GetResource('DLOG', dlgID));
- IF dlogTemplate <> NIL THEN
- BEGIN
- dialogRect := dlogTemplate^^.boundsRect;
- CenterRectOnScreen(dialogRect, TRUE, TRUE, TRUE);
- where := dialogRect.topleft;
- END
- ELSE
- SetPt(where, 100, 100);
-
- CASE itsCmdNumber OF
- cSave, cSaveAs:
- idx := bzSaveAs;
- cSaveCopy:
- idx := bzSaveCopy;
- OTHERWISE
- idx := 0;
- END;
-
- IF idx = 0 THEN
- prompt := ''
- ELSE
- GetIndString(prompt, kIDBuzzString, idx);
-
- dlgHook := NIL;
- filterProc := NIL;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAReadFile}
-
- PROCEDURE TDocument.ShowReverted;
-
- PROCEDURE RevertView(aView: TView);
-
- BEGIN
- aView.ShowReverted;
- END;
-
- BEGIN
- ForAllViewsDo(RevertView);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAOpen}
-
- PROCEDURE TDocument.ShowWindows;
-
- FUNCTION ShowAWindow(aWindow: TWindow): BOOLEAN;
-
- BEGIN
- IF aWindow.fOpenInitially THEN
- aWindow.Open;
- ShowAWindow := FALSE;
- END;
-
- BEGIN
- { Make the windows open from back to front }
- IF (fWindowList <> NIL) & (fWindowList.LastThat(ShowAWindow) <> NIL) THEN;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAOpen}
-
- PROCEDURE TDocument.UntitledName(VAR noName: Str255);
-
- VAR
- preInsert: INTEGER;
- constChars: INTEGER;
- num: Str255;
-
- BEGIN
- GetIndString(noName, kIDBuzzString, bzUntitled);
- IF ParseTitleTemplate(noName, preInsert, constChars) THEN
- BEGIN
- NumToString(gNumUntitled, num);
-
- IF SubstituteInTitle(noName, num, preInsert, constChars) THEN
- gNumUntitled := gNumUntitled + 1;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAFields}
-
- PROCEDURE TDocument.Fields(PROCEDURE DoToField(fieldName: Str255;
- fieldAddr: Ptr;
- fieldType: INTEGER));
-
- BEGIN
- DoToField('TDocument', NIL, bClass);
- DoToField('fWindowList', @fWindowList, bObject);
- DoToField('fViewList', @fViewList, bObject);
- DoToField('fChangeCount', @fChangeCount, bLongInt);
- DoToField('fDocPrintHandler', @fDocPrintHandler, bObject);
- DoToField('fSavePrintInfo', @fSavePrintInfo, bBoolean);
- DoToField('fSharePrintInfo', @fSharePrintInfo, bBoolean);
- DoToField('fPrintInfo', @fPrintInfo, bHandle);
- DoToField('fTitle', @fTitle, bStringHandle);
- DoToField('fFileType', @fFileType, bOSType);
- DoToField('fCreator', @fCreator, bOSType);
- DoToField('fVolRefNum', @fVolRefNum, bInteger);
- DoToField('fModDate', @fModDate, bLongInt);
- DoToField('fReopenAlert', @fReopenAlert, bBoolean);
- DoToField('fSaveExists', @fSaveExists, bBoolean);
- DoToField('fCommitOnSave', @fCommitOnSave, bBoolean);
- DoToField('fUsesDataFork', @fUsesDataFork, bBoolean);
- DoToField('fUsesRsrcFork', @fUsesRsrcFork, bBoolean);
- DoToField('fDataOpen', @fDataOpen, bBoolean);
- DoToField('fRsrcOpen', @fRsrcOpen, bBoolean);
- DoToField('fDataPerm', @fDataPerm, bInteger);
- DoToField('fRsrcPerm', @fRsrcPerm, bInteger);
- DoToField('fDataRefnum', @fDataRefnum, bInteger);
- DoToField('fRsrcRefNum', @fRsrcRefnum, bInteger);
- DoToField('fSaveInPlace', @fSaveInPlace, bByte);
- INHERITED Fields(DoToField);
- END;
-